home *** CD-ROM | disk | FTP | other *** search
/ Atari Forever 4 / Atari Forever 4.zip / Atari Forever 4.iso / SERIE_AI / AI_064 / AI_064.ZIP / C64 / C64_DEMO.PGS / EMULATOR.MOD < prev   
Text File  |  1988-09-01  |  11KB  |  429 lines
  1. MODULE Emulator;
  2.  
  3. FROM   TextIO        IMPORT WriteCard,WriteString,REadString,
  4.                             WriteInt,WriteLn;
  5. FROM   Terminal      IMPORT BusyRead,Read,Write;
  6. FROM   MyTools1      IMPORT Input,Cls,Wait,Wrap,Crsat,Cursor,Reverse,WESC;
  7. FROM   SYSTEM        IMPORT CODE,BYTE,WORD,LONGWORD,ADDRESS,ADR;
  8. FROM   String        IMPORT InitStringModule,Pos,Concat,Copy,Strings,
  9.                      Length,GetTerminator,Compare,
  10.                      Delete,CompareResults;
  11. FROM   M2Conversions IMPORT ConvertCardinal;
  12. FROM   ASCII         IMPORT CharIsPrintable,DEL;
  13. FROM   GEMDOS        IMPORT RawScanIn,SFirst,SetDTA;
  14. FROM   Streams       IMPORT Stream,StreamKinds,OpenStream,CloseStream,
  15.                             EOS;
  16.  
  17.  
  18. CONST  Cup = 110C;
  19.        Cdn = 120C;
  20.        Clf = 113C;
  21.        Crt = 115C;
  22.        Ins = 122C;
  23.        Hme = 107C;
  24.        Hlp = 142C;
  25.        Und = 141C;
  26.  
  27.       Hmx64 = 20;
  28.       Hmy64 =  0;
  29.       
  30.       Spaces40 = "                                        ";
  31.       LastBasicLine = 500;
  32.        
  33.  
  34. TYPE   Strngs    = ARRAY[0..39] OF CHAR;
  35.        Screen64  = ARRAY[0..24] OF Strngs;
  36.        Charset   = SET OF CHAR;
  37.        BasicLine = ARRAY[0..38] OF CHAR;
  38.        DmaBuf    = RECORD
  39.                      Buf    : ARRAY [0..21] OF BYTE;
  40.                      Time   : WORD;
  41.                      Date   : WORD;
  42.                      Size   : LONGWORD;
  43.                      Name   : ARRAY [0..13] OF CHAR;
  44.                      Drive  : WORD;
  45.                      AuxBuf : ARRAY [0..15] OF BYTE;
  46.                    END;
  47.  
  48. VAR MyBuf : DmaBuf;
  49.     d1541 : Stream;
  50.      Scr  : Screen64;
  51.     Cx,Cy : CARDINAL;
  52.      S,C  : CHAR;
  53.       Mem : ARRAY[0..LastBasicLine] OF BasicLine;
  54.   CmdLine : BasicLine;
  55.   RevFlag : CARDINAL;
  56.   EMUL520 : BOOLEAN;
  57.  
  58. PROCEDURE OutScr64;
  59.  
  60. VAR i : CARDINAL;
  61.  
  62. BEGIN
  63.   Cursor(0);
  64.   FOR i := 0 TO 24 DO
  65.     Crsat(Hmy64+i,Hmx64); WriteString(Scr[i]);
  66.   END;
  67.   Crsat(Hmy64+Cy,Hmx64+Cx);
  68.   Cursor(1);
  69. END OutScr64;
  70.  
  71. PROCEDURE Clr64;
  72. VAR i:CARDINAL;
  73. BEGIN
  74.   Cx := 0; Cy := 0;
  75.   FOR i := 0 TO 24 DO Scr[i]:=Spaces40; END;
  76.   OutScr64;
  77.   Crsat(Hmy64,Hmx64);
  78. END Clr64;
  79.  
  80. PROCEDURE UpdLine;
  81. VAR i:CARDINAL;
  82. BEGIN
  83.   Cursor(0);
  84.   Crsat(Hmy64+Cy,Hmx64);
  85.   FOR i:=0 TO 39 DO Write(Scr[Cy][i]); END;
  86.   Crsat(Hmy64+Cy,Hmx64+Cx);
  87.   Cursor(1);
  88. END UpdLine;
  89.  
  90. PROCEDURE Print(VAR S:ARRAY OF CHAR);
  91. VAR l,i : CARDINAL;
  92. BEGIN
  93.   FOR i := 0 TO Length(S)-1 DO OutChr64(S[i],377C); END;
  94. END Print;
  95.  
  96. PROCEDURE PrintLn(VAR S:ARRAY OF CHAR);
  97. VAR l,i : CARDINAL;
  98. BEGIN
  99.   FOR i := 0 TO Length(S)-1 DO OutChr64(S[i],377C); END;
  100.   CR64;
  101. END PrintLn;
  102.  
  103. PROCEDURE CR64;
  104. BEGIN
  105.   RevFlag := 1; Reverse(1);
  106.   Cx := 0; Cy := Cy +1;
  107.   IF Cy > 24 THEN Cy := 24; Scroll64; END;
  108.   Crsat(Hmy64+Cy,Hmx64+Cx);
  109. END CR64;
  110.  
  111. PROCEDURE  Home64;
  112. BEGIN
  113.   Cx := 0; Cy := 0;
  114.   Crsat(Hmy64+Cy,Hmx64+Cx);
  115. END Home64;
  116.  
  117. PROCEDURE INS64;
  118. VAR i:CARDINAL;
  119. BEGIN
  120.   FOR i := 39 TO Cx+1 BY -1 DO Scr[Cy][i]:=Scr[Cy][i-1]; END;
  121.   Scr[Cy][Cx] := " ";
  122.   UpdLine;
  123. END INS64;
  124.  
  125. PROCEDURE DEL64;
  126. VAR i:CARDINAL;
  127. BEGIN
  128.   IF Cx > 0 THEN
  129.      FOR i := Cx TO 39 DO Scr[Cy][i-1]:=Scr[Cy][i] END;
  130.      Scr[Cy][39] := " ";
  131.      Cx := Cx - 1;
  132.      UpdLine;
  133.   END;
  134.   Crsat(Hmy64+Cy,Hmx64+Cx);
  135. END DEL64;
  136.  
  137. PROCEDURE OutChr64(C,S:CHAR);
  138. VAR d : CARDINAL;
  139. BEGIN
  140.   IF CharIsPrintable(C) THEN
  141.    IF C="|" THEN RevFlag := 1- RevFlag; Reverse(RevFlag);
  142.    ELSE
  143.      Scr[Cy][Cx] := C;
  144.      Crsat(Hmy64+Cy,Hmx64+Cx);
  145.      Write(C);
  146.      Cx := Cx +1;
  147.      IF Cx > 39 THEN CR64; END;
  148.      Crsat(Hmy64+Cy,Hmx64+Cx);
  149.    END;
  150.   ELSE
  151.     CASE C OF 
  152.       15C : CR64  |
  153.       DEL : DEL64 |
  154.       ELSE 
  155.         CASE S OF
  156.           Cup : IF Cy > 0 THEN Cy := Cy-1;
  157.                    Crsat(Hmy64+Cy,Hmx64+Cx);
  158.                 END; |
  159.           Cdn : IF Cy < 24 THEN Cy := Cy+1;
  160.                    Crsat(Hmy64+Cy,Hmx64+Cx);
  161.                 ELSE
  162.                   Scroll64;
  163.                 END; |
  164.           Clf : IF Cx > 0 THEN Cx := Cx -1;
  165.                 ELSE
  166.                   IF Cy > 0 THEN Cy := Cy-1; Cx := 39; END;
  167.                 END;
  168.                 Crsat(Hmy64+Cy,Hmx64+Cx); |
  169.           Crt : IF Cx < 39 THEN Cx := Cx+1;
  170.                 ELSE
  171.                   Cy := Cy+1; Cx := 0;
  172.                   IF Cy=25 THEN Cy := 24; Scroll64; END;
  173.                 END;
  174.                 Crsat(Hmy64+Cy,Hmx64+Cx); |
  175.           Ins : INS64;  |
  176.           Hme : Home64; |
  177.           Und : Clr64; 
  178.           ELSE ;
  179.       END;
  180.     END;
  181.   END;
  182. END OutChr64;
  183.  
  184. PROCEDURE Scroll64;
  185. VAR i : CARDINAL;
  186. BEGIN
  187.   FOR i := 1 TO 24 DO Scr[i-1] := Scr[i]; END;
  188.   Scr[24] := Spaces40;
  189.   Cursor(0);
  190.   Crsat(24,Hmx64);
  191.   Write(12C);
  192.   WriteString(Spaces40);
  193.   Crsat(Hmy64+Cy,Hmx64+Cx);
  194.   Cursor(1);
  195. END Scroll64;
  196.  
  197. PROCEDURE Reset64;
  198. BEGIN
  199.   Cls(1);
  200.   Reverse(1);
  201.   RevFlag := 1;
  202.   Clr64;
  203.   BASNEW;
  204.   CR64;
  205.   PrintLn("   ****  Commodore 64 BASIC V2  ****   ");
  206.   CR64;
  207.   PrintLn(" 64 K RAM SYSTEM 38911 BASIC BYTES FREE");
  208.   CR64;
  209.   PrintLn("READY.");
  210. END Reset64;
  211.  
  212. PROCEDURE BASNEW;
  213. VAR i : CARDINAL;
  214. BEGIN FOR i:=0 TO LastBasicLine DO Mem[i][0] := GetTerminator(); END;
  215. END BASNEW;
  216.  
  217. PROCEDURE CutBlanks(VAR Source,T:Strngs);
  218. VAR i,s,e : INTEGER;
  219.     Target:Strngs;
  220. BEGIN
  221.   s := 0; e := Length(Source)-1;
  222.   IF e >= 0 THEN
  223.     WHILE (s < 39) AND (Source[s]=" ") DO s := s + 1; END;
  224.     WHILE  (e >=0) AND (Source[e]=" ") DO e := e - 1; END;
  225.     FOR i := s TO e DO Target[i-s] := Source[i]; END;
  226.     IF e >= s THEN
  227.       Target[e-s+1] := GetTerminator();
  228.     ELSE Target[0]  := GetTerminator(); END;    
  229.   END;
  230.   T := Target;
  231. END CutBlanks;
  232.  
  233. PROCEDURE Store(VAR S:Strngs);
  234. (* S MUST start with digit ! *)
  235. VAR P,Line : CARDINAL;
  236. BEGIN
  237.  Line := 0; P:=0;
  238.  IF S[0] IN Charset {"0".."9"} THEN
  239.   WHILE (S[P] IN Charset {"0".."9"}) AND (Line <= LastBasicLine)  DO
  240.         Line := Line*10+ORD(S[P])-ORD("0");
  241.         P := P + 1;
  242.   END;
  243.   IF Line <= LastBasicLine THEN 
  244.      Mem[Line] := S;
  245.      IF P = Length(S) THEN Mem[Line][0] := GetTerminator(); END;
  246.   ELSE
  247.      PrintLn("?Out of memory error.");
  248.   END;
  249.  END;
  250. END Store;
  251.  
  252. PROCEDURE PBASNEW(VAR Arg : Strngs) : BOOLEAN;
  253. BEGIN 
  254.   BASNEW;
  255.   RETURN(TRUE);
  256. END PBASNEW;
  257.  
  258. PROCEDURE LIST(VAR Arg : Strngs) : BOOLEAN;
  259. VAR i,from,to : CARDINAL;
  260.     flag : BOOLEAN;
  261. BEGIN
  262.   Cursor(0);
  263.   FOR i := 0 TO LastBasicLine DO
  264.       IF Length(Mem[i]) > 0 THEN
  265.          PrintLn(Mem[i]);
  266.       END;
  267.   END;
  268.   Cursor(1);
  269.   RETURN(TRUE);
  270. END LIST;
  271.  
  272. PROCEDURE LOAD(Arg : Strngs):BOOLEAN;
  273. VAR Name,F64,Line : Strings;
  274.     a,e,l,i,j:CARDINAL;
  275.           Err:INTEGER;
  276. BEGIN
  277.   l:=Length(Arg);
  278.   IF Arg[0]<>42C THEN RETURN(FALSE); END;
  279.   IF Arg[l-1] <> "8" THEN PrintLn("?DEVICE NOT PRESENT ERROR.");
  280.                           RETURN(TRUE); END;
  281.   e := l;
  282.   WHILE Arg[e]<>42C DO e := e -1; END;
  283.   IF e<2 THEN RETURN(FALSE); END;
  284.   Copy(Arg,1,e-1,F64);
  285.   Print("Searching for "); Print(F64); CR64;
  286.   IF F64[0]="$" THEN F64 := "DIR"; END;
  287.   Concat("\1541\",F64,Name);
  288.   OpenStream(d1541,Name,READ,Err);
  289.   IF Err<>0 THEN PrintLn("?FILE NOT FOUND ERROR.");
  290.                CloseStream(d1541,Err);
  291.                RETURN(TRUE);
  292.   ELSE
  293.     BASNEW;
  294.     PrintLn("LOADING");
  295.     WHILE NOT EOS(d1541) DO
  296.       REadString(d1541,Line);
  297.       Line[40] := GetTerminator();
  298.       CutBlanks(Line,Line);
  299.       Store(Line);
  300.     END;
  301.     CloseStream(d1541,Err);
  302.     RETURN(TRUE);
  303.   END;
  304. END LOAD; 
  305.  
  306. PROCEDURE RUN(Rest:Strngs):BOOLEAN;
  307. VAR line10 : Strngs;
  308.     where  : CARDINAL;
  309. BEGIN
  310.   line10 := Mem[10];
  311.   IF Pos(line10,"TEST",0,where) THEN
  312.      DOTEST;
  313.      RETURN(TRUE);
  314.   END;
  315.   IF Pos(line10,"SYS",0,where) THEN
  316.      DOSYS;
  317.      RETURN(TRUE);
  318.   END;
  319.   PrintLn("SYNTAX ERROR IN 10");
  320.   RETURN(TRUE);
  321. END RUN;
  322.  
  323. PROCEDURE DOTEST;
  324. VAR I:INTEGER;
  325. BEGIN
  326.   FOR I:=1 TO 100 DO WriteInt(I,8); WriteInt(I*I,8); CR64; END;
  327.   PrintLn("YEAH,IT WORKS !!");
  328.   CR64;
  329. END DOTEST;
  330.  
  331. PROCEDURE Dprint(S : Strngs);
  332. VAR i :LONGCARD;
  333. BEGIN
  334.   PrintLn(S);
  335.   FOR i:=1 TO 200000 DO ; END;
  336. END Dprint;
  337.  
  338. PROCEDURE DOSYS;
  339. BEGIN
  340.   EMUL520 := TRUE;
  341.   Clr64;
  342.   PrintLn("*** C64 - GEM  ***");
  343.   PrintLn("Installation procedure ...");
  344.   Dprint("Memory Bit-compression :");
  345.   Dprint("128 K RAM check ok.");
  346.   Dprint("256 K RAM check ok.");
  347.   Dprint("512 K RAM check ok.");
  348.   Dprint("1024 K (1MB) RAM check ok.");
  349.   CR64;
  350.   Dprint("Clock speed up : 1MHz");
  351.   Dprint("                 2MHz");
  352.   Dprint("                 3MHz");
  353.   Dprint("                 4MHz");
  354.   Dprint("                 8MHz");
  355.   Dprint("                16MHz");
  356.   Dprint("*** Ram response too slow ***");
  357.   Dprint("Clock switched back to 8 MHz");
  358.   Dprint("----------------------------");
  359.   Dprint("Horizontal video freq. :");
  360.   Dprint("doubled.Video shifter-enable:");
  361.   Cls(0); Reverse(0);
  362.   WriteString("Done.8 MHz clock gated to processor input now");
  363.   WriteLn;
  364.   WriteString("*** Error : Harddisk simulator cannot be activated ***");
  365.   WriteLn;
  366.   WriteString("  CBM 1541 drive is (physically) required for this.");
  367.   WriteLn;
  368.   WriteString(" Hit the SPACE key on your C64 to start the simulated ");
  369.   WriteLn;
  370.   WriteString(" GEM (C) (TM) Desktop routines "); Wait(" ");
  371.   Cls(0);
  372. END DOSYS; (* brrr *)
  373.  
  374. PROCEDURE BASIC64;
  375. VAR Cmd : Strngs;
  376. BEGIN
  377.   IF Length(CmdLine)>0 THEN CutBlanks(CmdLine,Cmd); END;
  378.   IF Cmd[0] IN Charset {"0".."9"} THEN
  379.     Store(Cmd);
  380.   ELSE 
  381.     IF Length(Cmd) > 0 THEN
  382.        Cursor(0);
  383.        IF NOT EXEC(Cmd) THEN PrintLn("?SYNTAX ERROR."); END;
  384.        PrintLn("READY.");
  385.        Cursor(1);
  386.     END;
  387.   END;
  388. END BASIC64;
  389.  
  390. PROCEDURE EXEC(VAR S:Strngs):BOOLEAN;
  391. VAR     L,Cmd,Rest : Strngs;
  392.               Flag : BOOLEAN;
  393.              i,a,e : CARDINAL;
  394. BEGIN
  395.   L := S;
  396.   (* Find end of command *)
  397.   IF Length(L)=0 THEN
  398.     RETURN(TRUE);
  399.   ELSE
  400.     WHILE L[0] = ":" DO Delete(L,0,1); END; (* IGNORE ":" *)
  401.     e := 0;
  402.     WHILE L[e] IN Charset {"A".."Z"} DO e := e + 1; END;
  403.     IF e=0 THEN RETURN(FALSE); END;
  404.     Copy(L,0,e,Cmd);
  405.     Copy(L,e,Length(L)-e,Rest);
  406.     CutBlanks(Rest,Rest);
  407.     Flag := FALSE;
  408.     IF (Compare("LIST",Cmd)=Equal) THEN Flag:=LIST(Rest); END;
  409.     IF (Compare("NEW",Cmd)=Equal)  THEN Flag:=PBASNEW(Rest); END;
  410.     IF (Compare("LOAD",Cmd)=Equal) THEN Flag:=LOAD(Rest); END;
  411.     IF (Compare("RUN",Cmd)=Equal)  THEN Flag:=RUN(Rest); END;
  412.     RETURN(Flag);
  413.   END;
  414. END EXEC;
  415.     
  416. BEGIN
  417.   EMUL520 := FALSE;
  418.   InitStringModule;
  419.   SetDTA(ADR(MyBuf));
  420.   Reset64;
  421.   REPEAT
  422.     C := 377C;
  423.     RawScanIn(C,S); IF C=15C THEN CmdLine := Scr[Cy]; END;
  424.     OutChr64(C,S);
  425.     IF C=15C THEN BASIC64; END;
  426.   UNTIL (C=3C) OR EMUL520;
  427.   Cursor(0);
  428. END Emulator.
  429.